home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / tptc17tc.zip / UNSQ.PAS < prev    next >
Pascal/Delphi Source File  |  1988-03-25  |  24KB  |  965 lines
  1.  
  2. (*
  3.  DEARC.PAS - Program to extract all files from an archive created by version
  4.              5.12 or earlier of the ARC utility.
  5.  
  6.    *** ORIGINAL AUTHOR UNKNOWN ***
  7. *)
  8.  
  9. Program DearcSQ;
  10.  
  11. {$R-}
  12. {$U-}
  13. {$C-}
  14. {$K-}
  15.  
  16. const 
  17.       BLOCKSIZE = 128;
  18.       arcmarc   = 26;              { special archive marker }
  19.       arcver    = 9;               { max archive header version code }
  20.       strlen    = 100;             { standard string length }
  21.       fnlen     = 12;              { file name length - 1 }
  22.  
  23. const 
  24.   crctab : array [0..255] of integer =
  25.   ( $0000, $C0C1, $C181, $0140, $C301, $03C0, $0280, $C241,
  26.     $C601, $06C0, $0780, $C741, $0500, $C5C1, $C481, $0440,
  27.     $CC01, $0CC0, $0D80, $CD41, $0F00, $CFC1, $CE81, $0E40,
  28.     $0A00, $CAC1, $CB81, $0B40, $C901, $09C0, $0880, $C841,
  29.     $D801, $18C0, $1980, $D941, $1B00, $DBC1, $DA81, $1A40,
  30.     $1E00, $DEC1, $DF81, $1F40, $DD01, $1DC0, $1C80, $DC41,
  31.     $1400, $D4C1, $D581, $1540, $D701, $17C0, $1680, $D641,
  32.     $D201, $12C0, $1380, $D341, $1100, $D1C1, $D081, $1040,
  33.     $F001, $30C0, $3180, $F141, $3300, $F3C1, $F281, $3240,
  34.     $3600, $F6C1, $F781, $3740, $F501, $35C0, $3480, $F441,
  35.     $3C00, $FCC1, $FD81, $3D40, $FF01, $3FC0, $3E80, $FE41,
  36.     $FA01, $3AC0, $3B80, $FB41, $3900, $F9C1, $F881, $3840,
  37.     $2800, $E8C1, $E981, $2940, $EB01, $2BC0, $2A80, $EA41,
  38.     $EE01, $2EC0, $2F80, $EF41, $2D00, $EDC1, $EC81, $2C40,
  39.     $E401, $24C0, $2580, $E541, $2700, $E7C1, $E681, $2640,
  40.     $2200, $E2C1, $E381, $2340, $E101, $21C0, $2080, $E041,
  41.     $A001, $60C0, $6180, $A141, $6300, $A3C1, $A281, $6240,
  42.     $6600, $A6C1, $A781, $6740, $A501, $65C0, $6480, $A441,
  43.     $6C00, $ACC1, $AD81, $6D40, $AF01, $6FC0, $6E80, $AE41,
  44.     $AA01, $6AC0, $6B80, $AB41, $6900, $A9C1, $A881, $6840,
  45.     $7800, $B8C1, $B981, $7940, $BB01, $7BC0, $7A80, $BA41,
  46.     $BE01, $7EC0, $7F80, $BF41, $7D00, $BDC1, $BC81, $7C40,
  47.     $B401, $74C0, $7580, $B541, $7700, $B7C1, $B681, $7640,
  48.     $7200, $B2C1, $B381, $7340, $B101, $71C0, $7080, $B041,
  49.     $5000, $90C1, $9181, $5140, $9301, $53C0, $5280, $9241,
  50.     $9601, $56C0, $5780, $9741, $5500, $95C1, $9481, $5440,
  51.     $9C01, $5CC0, $5D80, $9D41, $5F00, $9FC1, $9E81, $5E40,
  52.     $5A00, $9AC1, $9B81, $5B40, $9901, $59C0, $5880, $9841,
  53.     $8801, $48C0, $4980, $8941, $4B00, $8BC1, $8A81, $4A40,
  54.     $4E00, $8EC1, $8F81, $4F40, $8D01, $4DC0, $4C80, $8C41,
  55.     $4400, $84C1, $8581, $4540, $8701, $47C0, $4680, $8641,
  56.     $8201, $42C0, $4380, $8341, $4100, $81C1, $8081, $4040 );
  57.  
  58. type 
  59.      longtype    = record           { used to simulate long (4 byte) integers }
  60.                  l, h : integer
  61.                end;
  62.  
  63.      strtype = string[strlen];
  64.      fntype  = array [0..fnlen] of char;
  65.      buftype = array [1..BLOCKSIZE] of byte;
  66.      heads   = record
  67.                  name   : fntype;
  68.                  size   : longtype;
  69.                  date   : integer;
  70.                  time   : integer;
  71.                  crc    : integer;
  72.                  length : longtype
  73.                end;
  74.  
  75. var 
  76.     hdrver   : byte;
  77.     arcfile  : file;
  78.     arcbuf   : buftype;
  79.     arcptr   : integer;
  80.     arcname  : strtype;
  81.     endfile  : boolean;
  82.     extfile  : file;
  83.     extbuf   : buftype;
  84.     extptr   : integer;
  85.     extname  : strtype;
  86.  
  87. { definitions for unpack }
  88.  
  89. Const
  90.    DLE = $90;
  91.  
  92. Var
  93.    state  : (NOHIST, INREP);
  94.    crcval : integer;
  95.    size   : real;
  96.    lastc  : integer;
  97.  
  98. { definitions for unsqueeze }
  99.  
  100. Const
  101.    ERROR   = -1;
  102.    SPEOF   = 256;
  103.    NUMVALS = 256;               { 1 less than the number of values }
  104.  
  105. Type
  106.    nd = record
  107.            child : array [0..1] of integer
  108.         end;
  109.  
  110. Var
  111.    node     : array [0..NUMVALS] of nd;
  112.    bpos     : integer;
  113.    curin    : integer;
  114.    numnodes : integer;
  115.  
  116. { definitions for uncrunch }
  117.  
  118. Const
  119.    TABSIZE   = 4096;
  120.    TABSIZEM1 = 4095;
  121.    NO_PRED   = $FFFF;
  122.    EMPTY     = $FFFF;
  123.  
  124. Type
  125.    entry = record
  126.               used         : boolean;
  127.               next         : integer;
  128.               predecessor  : integer;
  129.               follower     : byte
  130.            end;
  131.  
  132. Var
  133.    stack       : array [0..TABSIZEM1] of byte;
  134.    sp          : integer;
  135.    string_tab  : array [0..TABSIZEM1] of entry;
  136.  
  137. Var
  138.    code_count : integer;
  139.    code       : integer;
  140.    firstc     : boolean;
  141.    oldcode    : integer;
  142.    finchar    : integer;
  143.    inbuf      : integer;
  144.    outbuf     : integer;
  145.    newhash    : boolean;
  146.  
  147. { definitions for dynamic uncrunch }
  148.  
  149. Const
  150.   Crunch_BITS = 12;
  151.   Squash_BITS = 13;
  152.   HSIZE = 8192;
  153.   INIT_BITS = 9;
  154.   FIRST = 257;
  155.   CLEAR = 256;
  156.   HSIZEM1 = 8191;
  157.   BITSM1 = 12;
  158.  
  159.   RMASK : array[0..8] of byte =
  160.   ($00, $01, $03, $07, $0f, $1f, $3f, $7f, $ff);
  161.  
  162. Var
  163.   bits,
  164.   n_bits,
  165.   maxcode    : integer;
  166.   prefix     : array[0..HSIZEM1] of integer;
  167.   suffix     : array[0..HSIZEM1] of byte;
  168.   buf        : array[0..BITSM1]  of byte;
  169.   clear_flg  : integer;
  170.   stack1     : array[0..HSIZEM1] of byte;
  171.   free_ent   : integer;
  172.   maxcodemax : integer;
  173.   offset,
  174.   sizex      : integer;
  175.   firstch    : boolean;
  176.  
  177. procedure abortme(s : strtype);
  178. { terminate the program with an error message }
  179. begin
  180.   writeln('ABORT: ', s);
  181.   halt;
  182. end; (* proc abortme *)
  183.  
  184. function fn_to_str(var fn : fntype) : strtype;
  185. { convert strings from C format (trailing 0) to Turbo Pascal format (leading
  186.     length byte). }
  187. var s : strtype;
  188.     i : integer;
  189. begin
  190.   s := '';
  191.   i := 0;
  192.   while fn[i] <> #0 do begin
  193.     s := s + fn[i];
  194.     i := i + 1
  195.     end;
  196.   fn_to_str := s
  197. end; (* func fn_to_str *)
  198.  
  199. function unsigned_to_real(u : integer) : real;
  200. { convert unsigned integer to real }
  201. { note: INT is a function that returns a REAL!!!}
  202. begin
  203.   if u >= 0 then
  204.     unsigned_to_real := Int(u)
  205.   else
  206.   if u = $8000 then
  207.     unsigned_to_real := 32768.0
  208.   else
  209.     unsigned_to_real := 65536.0 + u
  210. end; (* func unsigned_to_real *)
  211.  
  212. function long_to_real(l : longtype) : real;
  213. { convert longtype integer to a real }
  214. { note: INT is a function that returns a REAL!!! }
  215. var r : real;
  216.     s : (posit, NEG);
  217. const rcon = 65536.0;
  218. begin
  219.   if l.h >= 0 then begin
  220.     r := Int(l.h) * rcon;
  221.     s := posit          {notice: no ";" here}
  222.     end
  223.   else begin
  224.     s := NEG;
  225.     if l.h = $8000 then
  226.       r := rcon * rcon
  227.     else
  228.       r := Int(-l.h) * rcon
  229.     end;
  230.   r := r + unsigned_to_real(l.l);
  231.   if s = NEG then
  232.     long_to_real := -r
  233.   else
  234.     long_to_real := r
  235. end; (* func long_to_real *)
  236.  
  237. procedure Read_Block;
  238. { read a block from the archive file }
  239. begin
  240.   if EOF(arcfile) then
  241.     endfile := TRUE
  242.   else
  243.     BlockRead(arcfile, arcbuf, 1);
  244.   arcptr := 1
  245. end; (* proc read_block *)
  246.  
  247. procedure Write_Block;
  248. { write a block to the extracted file }
  249. begin
  250.   BlockWrite(extfile, extbuf, 1);
  251.   extptr := 1
  252. end; (* proc write_block *)
  253.  
  254. procedure open_arc;
  255. { open the archive file for input processing }
  256. begin
  257.   {$I-} assign(arcfile, arcname); {$I+}
  258.   if ioresult <> 0 then
  259.     abortme('Cannot open archive file.');
  260.   {$I-} reset(arcfile); {$I+}
  261.   if ioresult <> 0 then
  262.     abortme('Cannot open archive file.');
  263.   endfile := FALSE;
  264.   Read_Block
  265. end; (* proc open_arc *)
  266.  
  267. procedure open_ext;
  268. { open the extracted file for writing }
  269. begin
  270.   {$I-} assign(extfile, extname); {$I+}
  271.   if ioresult <> 0 then
  272.     abortme('Cannot open extract file.');
  273.   {$I-} rewrite(extfile); {$I+}
  274.   if ioresult <> 0 then
  275.     abortme('Cannot open extract file.');
  276.   extptr := 1;
  277. end; (* proc open_ext *)
  278.  
  279. function get_arc : byte;
  280. { read 1 character from the archive file }
  281. begin
  282.   if endfile then
  283.     get_arc := 0
  284.   else begin
  285.     get_arc := arcbuf[arcptr];
  286.     if arcptr = BLOCKSIZE then
  287.       Read_Block
  288.     else
  289.       arcptr := arcptr + 1
  290.     end
  291. end; (* func get_arc *)
  292.  
  293. procedure put_ext(c : byte);
  294. { write 1 character to the extracted file }
  295. begin
  296.   extbuf[extptr] := c;
  297.   if extptr = BLOCKSIZE then
  298.     Write_Block
  299.   else
  300.     extptr := extptr + 1
  301. end; (* proc put_ext *)
  302.  
  303. procedure close_arc;
  304. { close the archive file }
  305. begin
  306.   close(arcfile)
  307. end; (* proc close_arc *)
  308.  
  309. procedure close_ext;
  310. { close the ext